home *** CD-ROM | disk | FTP | other *** search
/ Experimental BBS Explossion 3 / Experimental BBS Explossion III.iso / pascal / scanh313.zip / HELPFILE.PAS next >
Pascal/Delphi Source File  |  1993-07-27  |  12KB  |  438 lines

  1. unit HelpFiles;
  2.  
  3.   { Unit to define abstract help file object.  Included in SCANH3xx.ZIP
  4.     as sample of comment formatting and TeX output. }
  5.  
  6.   {#M}
  7.   { This comment will be highlighted as example text in most output formats.
  8.     The sample below won't be word-wrapped. }
  9.   {#F}
  10.   {  program HelloWorld;  }
  11.   {  begin                }
  12.   {    writeln('Hello, world!'); }
  13.   {  end.                 }
  14.   {#F}
  15.   {#M}
  16.  
  17. interface
  18.  
  19. uses OPString, Objects, Sorts, TokenUnit;
  20.  
  21. type
  22.   PTopic = ^TTopic;
  23.   TTopic
  24.   = object(TObject)
  25.       { An object holding a single topic as part of a #THelpFile#. }
  26.  
  27.       Text : PStream;
  28.       { A stream to which the text of the topic is written. }
  29.  
  30.       TopicNum : Word; { The topic number in the help file. }
  31.       StartofLine : Boolean; { Whether the text is currently at the
  32.                              start of a line. }
  33.       FixedLines : Boolean;  { Whether lines should be fixed or wrapped }
  34.       Marked : Boolean;      { Whether text is currently being marked }
  35.       Highlighting : byte;   { Counts the current highlight level }
  36.  
  37.       constructor Init(Atopicnum : Word);
  38.         { Initialize an empty topic with the given value for #TopicNum#. }
  39.  
  40.       destructor Done; virtual;
  41.         { Dispose of #Text# and destroy object. }
  42.  
  43.       function GetLine(var Buffer; MaxLen : Word) : Word; virtual;
  44.         { Gets the next line of text, return the length }
  45.  
  46.       function MoreLines : Boolean; virtual;
  47.         { True if there are more lines of text. }
  48.  
  49.       procedure Write(s : String); virtual;
  50.         { Writes the string to the help text }
  51.  
  52.       procedure WriteLn(const s : String); virtual;
  53.         { Writes, then adds a newline }
  54.  
  55.       procedure WriteKeyWord(const s : String; Crossref : Word); virtual;
  56.         { Writes the string with a marker that it's a cross-reference }
  57.  
  58.       procedure HighLight(On : Boolean); virtual;
  59.     { Turns highlighting of the text on or off.  If turned on twice, it will need
  60.       to be turned off twice to return to standard. }
  61.  
  62.       procedure ResetHighLight; virtual;
  63.     { Turns highlighting off regardless of the initial state. }
  64.  
  65.       procedure BlankLine; virtual;
  66.     { Writes a blank line to the help topic, starting a new paragraph
  67.       afterwards. }
  68.  
  69.       procedure StartXrefList(const s : String); virtual;
  70.     { Starts a list of cross-referenced topics. End the list with
  71.       #EndXrefList#. }
  72.  
  73.       procedure WriteXref(const s : String; Len, Crossref : Word); virtual;
  74.     { Like #WriteKeyWord#, but writes an entry to a cross-ref list. Len
  75.       is the length in characters of the longest Xref to come; this may
  76.       be used to format nicely. Assumes that #StartXrefList# has been called. }
  77.  
  78.       procedure EndXrefList; virtual;
  79.     { Ends a list of cross-referenced topics started by #StartXrefList#. }
  80.  
  81.       procedure ToggleFixed; virtual;
  82.     { Toggles word-wrap mode.  Generally, help files start out word-wrapping;
  83.       this should turn it off.  The TTopic method just toggles #FixedLines#. }
  84.  
  85.       procedure ToggleMarked; virtual;
  86.     { Toggles word marking mode.  Typically marked text would be used for
  87.       code samples, as in the Borland help files.  This one just toggles
  88.       #Marked#. }
  89.     end;
  90.  
  91.   PIndexItem = ^TIndexItem;
  92.   TIndexItem
  93.   = record
  94.       { This is an item stored in the index for a help file. }
  95.  
  96.       Context : Word;
  97.       { The context or topic number. }
  98.  
  99.       Subtitle,
  100.       { The token number of the subtitle string. }
  101.       Token : TToken;
  102.       { The token number of the name of index entry. }
  103.     end;
  104.  
  105.   PIndex = ^TIndex;
  106.   TIndex
  107.   = object(TSortableCollection)
  108.       { This is an index for a help file, meant to hold #TIndexItem# records. }
  109.  
  110.       Sortby : (ByToken, BySubTitle, ByContext);
  111.       { Marks which sort order should be used. }
  112.  
  113.       procedure FreeItem(Item : Pointer); virtual;
  114.         { Disposes of a TIndexItem }
  115.  
  116.       function Compare(Item1, Item2 : Pointer) : Integer; virtual;
  117.         { Compares two index items according to the #Sortby# field. }
  118.  
  119.       procedure Insert(Item : Pointer); virtual;
  120.         { This inserts duplicates after existing values. }
  121.  
  122.       procedure AddItem(const ATitle, ASubtitle : String; Atopicnum : Word);
  123.         { Add a new index entry by specifying the strings to use. }
  124.  
  125.       procedure AddTokens(ATitle, ASubtitle : TToken; Atopicnum : Word);
  126.         { Add a new index entry by specifying the token numbers. }
  127.     end;
  128.  
  129.   PHelpFile = ^THelpFile;
  130.   THelpFile
  131.   = object(TObject)
  132.   { This is the main abstract object representing a help file.  It serves
  133.     as a container for #THelpTopic#s. }
  134.  
  135.       Index : PIndex;
  136.       { This is a #TIndex# maintained by the help file. }
  137.  
  138.       constructor Init;
  139.         { Construct an empty help file, and initialize #Index# to nil. }
  140.  
  141.       destructor Done; virtual;
  142.         { Destroy the object and dispose of the #Index#. }
  143.  
  144.       function NumTopics : Word; virtual;
  145.         { Return the number of topics in this file. }
  146.  
  147.       function GetTitle(TopicNum : Word) : String; virtual;
  148.         { Constructs a topic title for the given topic number. }
  149.  
  150.       function GetSubTitle(TopicNum : Word) : String; virtual;
  151.         { Constructs a topic subtitle. }
  152.  
  153.       function GetTopic(Context : Word) : PTopic; virtual;
  154.         { Extracts the given topic from the help file. }
  155.  
  156.       function NewTopic(Context : Word; Someinfo : Pointer) : PTopic; virtual;
  157.     { Constructs a new topic of the appropriate type. Someinfo might
  158.       be used by a descendant type. }
  159.  
  160.       procedure AddTopic(ATopic : PTopic); virtual;
  161.     { Writes the topic at the end of the base file, and records it with the
  162.       appropriate topic number.  If a topic with that number existed previously,
  163.       it'll effectively be deleted.
  164.       Atopic is disposed after adding it.}
  165.  
  166.       procedure DisplayTopic(var Where : Text; TopicNum : Word); virtual;
  167.         { Displays the given topic number. }
  168.  
  169.       procedure SetMainTopic(TopicNum : Word); virtual;
  170.         { Defines which Topic is the main contents topic. }
  171.  
  172.       procedure Rewrite(s : PStream); virtual;
  173.         { Rewrites the help file to the given stream.  }
  174.     end;
  175.  
  176. implementation
  177.  
  178.   constructor TTopic.Init(Atopicnum : Word);
  179.   begin
  180.     inherited Init;
  181.     TopicNum := Atopicnum;
  182.     StartofLine := True;
  183.   end;
  184.  
  185.   destructor TTopic.Done;
  186.   begin
  187.     if Text <> nil then
  188.       Dispose(Text, Done);
  189.     inherited Done;
  190.   end;
  191.  
  192.   function TTopic.GetLine(var Buffer; MaxLen : Word) : Word;
  193.     { Gets the next line of text, return the length }
  194.   begin
  195.     Abstract;
  196.   end;
  197.  
  198.   function TTopic.MoreLines : Boolean;
  199.     { True if there are more lines of text. }
  200.   begin
  201.     Abstract;
  202.   end;
  203.  
  204.   procedure TTopic.Write(s : String);
  205.     { Writes the string to the help text }
  206.   begin
  207.     if Length(s) > 0 then
  208.     begin
  209.       Text^.Write(s[1], Length(s));
  210.       StartofLine := False;
  211.     end;
  212.   end;
  213.  
  214.   procedure TTopic.WriteLn(const s : String);
  215.     { Writes, then adds a newline }
  216.   const
  217.     CRLF : array[1..2] of Char = ^M^J;
  218.   begin
  219.     Write(s);
  220.     Text^.Write(CRLF, 2);
  221.     StartofLine := True;
  222.   end;
  223.  
  224.   procedure TTopic.WriteKeyWord(const s : String; Crossref : Word);
  225.     { Writes the string with a marker that it's a cross-reference }
  226.   begin
  227.     Abstract;
  228.   end;
  229.  
  230.   procedure TTopic.HighLight(On : Boolean);
  231.   begin
  232.     if On then
  233.       inc(highlighting)
  234.     else
  235.       dec(highlighting);
  236.   end;
  237.  
  238.   procedure TTopic.ResetHighLight;
  239.   begin
  240.     while highlighting > 0 do
  241.       HighLight(false);
  242.     while highlighting < 0 do
  243.       HighLight(true);
  244.   end;
  245.  
  246.   procedure TTopic.BlankLine;
  247.   begin
  248.     if not StartofLine then
  249.       WriteLn('');
  250.     WriteLn('');
  251.   end;
  252.  
  253.   procedure TTopic.StartXrefList(const s : String);
  254.   begin
  255.     BlankLine;
  256.     WriteLn(s);
  257.     BlankLine;
  258.   end;
  259.  
  260.   procedure TTopic.WriteXref(const s : String; Len, Crossref : Word);
  261.   begin
  262.     WriteKeyWord(s, Crossref);
  263.     WriteLn(Pad('', Len+1-Length(s)));
  264.   end;
  265.  
  266.   procedure TTopic.EndXrefList;
  267.   begin
  268.   end;
  269.  
  270.   procedure TTopic.ToggleFixed;
  271.   begin
  272.     FixedLines := not FixedLines;
  273.   end;
  274.  
  275.   procedure TTopic.ToggleMarked;
  276.   begin
  277.     Marked := not Marked;
  278.   end;
  279.  
  280.   procedure TIndex.FreeItem(Item : Pointer);
  281.   begin
  282.     Dispose(PIndexItem(Item));
  283.   end;
  284.  
  285.   function TIndex.Compare(Item1, Item2 : Pointer) : Integer;
  286.   var
  287.     i1 : PIndexItem absolute Item1;
  288.     i2 : PIndexItem absolute Item2;
  289.     s1, s2 : String;
  290.   begin
  291.     case Sortby of
  292.       ByContext :
  293.         begin
  294.           s1 := HexW(i1^.Context);
  295.           s2 := HexW(i2^.Context);
  296.         end;
  297.       ByToken :
  298.         begin
  299.           s1 := Tokens.Num2Pstr(i1^.Token)^+#0+HexW(i1^.Context);
  300.           s2 := Tokens.Num2Pstr(i2^.Token)^+#0+HexW(i2^.Context);
  301.         end;
  302.       BySubTitle : { Sort by context number within subtitle }
  303.         begin
  304.           s1 := Tokens.Num2Pstr(i1^.Subtitle)^+#0+HexW(i1^.Context);
  305.           s2 := Tokens.Num2Pstr(i2^.Subtitle)^+#0+HexW(i2^.Context);
  306.         end;
  307.     end;
  308.     Compare := Ord(CompUCString(s1, s2))-1;
  309.   end;
  310.  
  311.   procedure TIndex.Insert(Item : Pointer);
  312.   var
  313.     i : Integer;
  314.     Key : Pointer;
  315.   begin
  316.     Key := KeyOf(Item);
  317.     if Search(Key, i) then
  318.     repeat
  319.       Inc(i);
  320.     until (i >= Count) or (Compare(Key, KeyOf(At(i))) <> 0);
  321.     AtInsert(i, Item);
  322.   end;
  323.  
  324.   procedure TIndex.AddItem(const ATitle, ASubtitle : String; Atopicnum : Word);
  325.   begin
  326.     if ASubtitle <> '' then
  327.       AddTokens(Tokens.Str2Num(ATitle), Tokens.Str2Num(ASubtitle),
  328.         Atopicnum)
  329.     else
  330.       AddTokens(Tokens.Str2Num(ATitle), NoToken, Atopicnum)
  331.   end;
  332.  
  333.   procedure TIndex.AddTokens(ATitle, ASubtitle : TToken; Atopicnum : Word);
  334.   var
  335.     Item : PIndexItem;
  336.   begin
  337.     New(Item);
  338.     if Item <> nil then
  339.     begin
  340.       with Item^ do
  341.       begin
  342.         Token := ATitle;
  343.         Context := Atopicnum;
  344.         Subtitle := ASubtitle;
  345.       end;
  346.       Insert(Item);
  347.     end;
  348.   end;
  349.  
  350.   constructor THelpFile.Init;
  351.   begin
  352.     inherited Init;
  353.     Index := nil;
  354.   end;
  355.  
  356.   destructor THelpFile.Done;
  357.   begin
  358.     if Index <> nil then
  359.       Dispose(Index, Done);
  360.     inherited Done;
  361.   end;
  362.  
  363.   function THelpFile.NumTopics : Word;
  364.   begin
  365.     Abstract;
  366.   end;
  367.  
  368.   function THelpFile.GetTitle(TopicNum : Word) : String;
  369.     { Constructs a topic title }
  370.   var
  371.     i : Word;
  372.   begin
  373.     for i := 0 to Pred(Index^.Count) do
  374.       with PIndexItem(Index^.At(i))^ do
  375.         if TopicNum = Context then
  376.         begin
  377.           GetTitle := Tokens.Num2Pstr(Token)^;
  378.           Exit;
  379.         end;
  380.     GetTitle := '';
  381.   end;
  382.  
  383.   function THelpFile.GetSubTitle(TopicNum : Word) : String;
  384.     { Constructs a topic subtitle }
  385.   var
  386.     i : Word;
  387.   begin
  388.     for i := 0 to Pred(Index^.Count) do
  389.       with PIndexItem(Index^.At(i))^ do
  390.         if TopicNum = Context then
  391.         begin
  392.           GetSubTitle := Tokens.Num2Pstr(Subtitle)^;
  393.           Exit;
  394.         end;
  395.     GetSubTitle := '';
  396.   end;
  397.  
  398.   function THelpFile.GetTopic(Context : Word) : PTopic;
  399.   begin
  400.     Abstract;
  401.   end;
  402.  
  403.   function THelpFile.NewTopic(Context : Word; Someinfo : Pointer) : PTopic;
  404.   begin
  405.     Abstract;
  406.   end;
  407.  
  408.   procedure THelpFile.AddTopic(ATopic : PTopic);
  409.   begin
  410.     with ATopic^ do
  411.     begin
  412.       if highlighting <> 0 then
  413.         ResetHighlight;
  414.       if FixedLines then
  415.         ToggleFixed;
  416.       if Marked then
  417.         ToggleMarked;
  418.     end;
  419.   end;
  420.  
  421.   procedure THelpFile.DisplayTopic(var Where : Text; TopicNum : Word);
  422.     { Displays the given topic number }
  423.   begin
  424.     Abstract;
  425.   end;
  426.  
  427.   procedure THelpFile.SetMainTopic(TopicNum : Word);
  428.   begin
  429.     Abstract;
  430.   end;
  431.  
  432.   procedure THelpFile.Rewrite(s : PStream);
  433.   begin
  434.     Abstract;
  435.   end;
  436.  
  437. end.
  438.